(*
 *
 *)


module type SigCoda =
  sig
    type 'a t

    exception EQ

    val createq: unit -> 'a t
    val isemptyq : 'a t -> bool
    val addhdq :'a -> 'a t -> unit
    val addtlq: 'a -> 'a t -> unit
    val takehdq: 'a t -> unit
    val qhd : 'a t -> 'a
    val qiter: 'a t -> ('a ref -> unit)  -> unit
    val queue2list: 'a t -> ('a ref) list
end


module CQ : SigCoda =
  struct

    type 'a reflist = Nil | Cons of 'a ref * 'a reflist ref 
    type 'a t = 'a reflist ref

    exception EQ 
    exception NP 


    let createq () = ref Nil 


(**)

    let isemptyq q = 
        match !q with
          Nil -> true
        | _ -> false
                     

    let addhdq a q = 
        match !q with
          Nil -> 
            let rn = ref Nil 
            in let nc = Cons(ref a, rn) 
               in rn := nc; q := nc

        | Cons(v, n) -> 
            let nn = !n 
            in let nc = Cons (ref a, ref nn) 
               in n:=nc 

    let addtlq a q =
        match !q with
          Nil -> addhdq a q 
        | Cons(v,n) -> addhdq a q;
                       match !q with 
                         Cons(tv, tn) -> q:= !tn 
                       | _ -> raise NP

(**)

    let takehdq q = 
      match !q with
        Nil -> raise EQ
      | Cons(tv,tn) ->
             match !tn with
               Cons(hv, hn) when (tn == hn) (* sono la stessa cella? *)
                   -> q := Nil; (* !hv *) 
             | Cons(hv, hn)
                   -> tn:=!hn; (* !hv *)
             | _ -> raise NP 



    let qhd q = 
      match !q with
        Nil -> raise EQ
      | Cons(tv,tn) ->
             match !tn with
               Cons(hv, hn) 
                   -> !hv
             | _ -> raise NP 

(**)


    let qiter q fq =
      let rec aux q c fq =
            match !c with
              Cons(v,n) when (!n == !q) (* puntano alla stessa cella? *)
                ->  fq v
            | Cons(v,n) 
                -> fq v; aux q n fq 
            | _ -> raise NP
                   
      in match !q with
             Nil -> () 
           | Cons(v,n) -> aux n n fq 




    let qprint q fp = 
        let rec aux q c fp =
            match !c with
              Cons(v,n) when (!n == !q) 
                ->  fp !v; print_string "->[...]"
            | Cons(v,n) 
                -> fp !v; print_string "->"; aux q n fp 
            | _ -> raise NP
                   
        in match !q with
             Nil -> print_string "[]"
           | _ -> aux q q fp 

    let queue2list q =
      let rec aux q c l =
            match !c with
              Cons(v,n) when (!n == !q) (* puntano alla stessa cella? *)
                ->  v::l
            | Cons(v,n) 
                -> aux q n (v::l) 
            | _ -> raise NP
                   
      in match !q with
             Nil -> []
           | Cons(v,n) -> aux n n []

end
(*
 *
 *)
